home *** CD-ROM | disk | FTP | other *** search
- /* Copyright (C) 1995 Free Software Foundation, Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2, or (at your option)
- * any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING. If not, write to
- * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
- *
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
- *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE. If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way. To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
- *
- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.
- */
-
-
- #include <stdio.h>
- #include "_scm.h"
- #include "unix.h"
- #include <pwd.h>
- #include <sys/types.h>
- #include <sys/stat.h>
-
- SCM scm_stat2scm P((struct stat *stat_temp));
-
-
- PROC (s_sys_mknod, "%mknod", 3, 0, 0, scm_sys_mknod);
- #ifdef __STDC__
- SCM
- scm_sys_mknod(SCM path, SCM mode, SCM dev)
- #else
- SCM
- scm_sys_mknod(path, mode, dev)
- SCM path;
- SCM mode;
- SCM dev;
- #endif
- {
- int val;
- ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_sys_mknod);
- ASSERT(INUMP(mode), mode, ARG2, s_sys_mknod);
- ASSERT(INUMP(dev), dev, ARG3, s_sys_mknod);
- SYSCALL(val = mknod(CHARS(path), INUM(mode), INUM(dev)));
- return val ? BOOL_F : BOOL_T;
- }
-
-
- PROC (s_sys_acct, "%acct", 1, 0, 0, scm_sys_acct);
- #ifdef __STDC__
- SCM
- scm_sys_acct(SCM path)
- #else
- SCM
- scm_sys_acct(path)
- SCM path;
- #endif
- {
- int val;
- if (FALSEP(path))
- {
- SYSCALL(val = acct(0););
- return val ? BOOL_F : BOOL_T;
- }
- ASSERT(NIMP(path) && STRINGP(path), path, ARG1, s_sys_acct);
- SYSCALL(val = acct(CHARS(path)));
- return val ? BOOL_F : BOOL_T;
- }
-
-
- PROC (s_sys_nice, "%nice", 1, 0, 0, scm_sys_nice);
- #ifdef __STDC__
- SCM
- scm_sys_nice(SCM incr)
- #else
- SCM
- scm_sys_nice(incr)
- SCM incr;
- #endif
- {
- ASSERT(INUMP(incr), incr, ARG1, s_sys_nice);
- return nice(INUM(incr)) ? BOOL_F : BOOL_T;
- }
-
-
- PROC (s_sync, "sync", 0, 0, 0, scm_sync);
- #ifdef __STDC__
- SCM
- scm_sync(void)
- #else
- SCM
- scm_sync()
- #endif
- {
- sync();
- return UNSPECIFIED;
- }
-
-
- PROC (s_sys_symlink, "%symlink", 2, 0, 0, scm_sys_symlink);
- #ifdef __STDC__
- SCM
- scm_sys_symlink(SCM oldpath, SCM newpath)
- #else
- SCM
- scm_sys_symlink(oldpath, newpath)
- SCM oldpath;
- SCM newpath;
- #endif
- {
- int val;
- ASSERT(NIMP(oldpath) && STRINGP(oldpath), oldpath, ARG1, s_sys_symlink);
- ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG2, s_sys_symlink);
- SYSCALL(val = symlink(CHARS(oldpath), CHARS(newpath)));
- return val ? BOOL_F : BOOL_T;
- }
-
-
- PROC (s_sys_readlink, "%readlink", 1, 0, 0, scm_sys_readlink);
- #ifdef __STDC__
- SCM
- scm_sys_readlink(SCM path)
- #else
- SCM
- scm_sys_readlink(path)
- SCM path;
- #endif
- {
- sizet rv;
- sizet size = 100;
- char *buf;
- SCM result = BOOL_F;
- ASSERT (NIMP (path) && STRINGP (path), path, (char *) ARG1, s_sys_readlink);
- DEFER_INTS;
- buf = scm_must_malloc (size, s_sys_readlink);
- while ((rv = readlink (CHARS (path), buf, (sizet) size)) == size)
- {
- scm_must_free (buf);
- size *= 2;
- buf = scm_must_malloc (size, s_sys_readlink);
- }
- if (rv != -1)
- result = scm_makfromstr (buf, rv, 0);
- scm_must_free (buf);
- ALLOW_INTS;
- return result;
- }
-
-
- PROC (s_sys_lstat, "%lstat", 1, 0, 0, scm_sys_lstat);
- #ifdef __STDC__
- SCM
- scm_sys_lstat(SCM str)
- #else
- SCM
- scm_sys_lstat(str)
- SCM str;
- #endif
- {
- int i;
- struct stat stat_temp;
- ASSERT(NIMP(str) && STRINGP(str), str, (char *)ARG1, s_sys_lstat);
- SYSCALL(i = lstat(CHARS(str), &stat_temp));
- return i ? BOOL_F : scm_stat2scm(&stat_temp);
- }
-
- #ifdef __STDC__
- void
- scm_init_unix (void)
- #else
- void
- scm_init_unix ()
- #endif
- {
- #include "unix.x"
- scm_add_feature ("unix");
- }
-